perm filename TALE.SAI[BRK,DEK] blob
sn#543094 filedate 1980-11-06 generic text, type T, neo UTF8
begin comment tests of line-breaking;
require "⊂⊃⊂⊃" delimiters;
define # = ⊂;comment⊃; "used henceforth instead of quoted comments"
external procedure bail;
integer m,tracing,hyphs,s1,s2,s3,s4,s5,s6,s7,s8,s9;
real l,maxr,minr;
real array w,y,z,w1,y1,z1,w2,y2,z2[0:2000];
integer array t,p,f,b,c[0:2000];
define boxitem=0, glueitem=1, penaltyitem=2;
procedure box(real wd) # makes a box of width wd;
begin m←m+1; t[m]←boxitem; w[m]←wd;
end;
procedure glue(real wd,st,sh) # makes glue of wd plus st minus sh;
begin m←m+1; t[m]←glueitem; w[m]←wd; y[m]←st; z[m]←sh;
end;
procedure penalty(real wd; integer pn,fl) # makes a penalty item;
begin m←m+1; t[m]←penaltyitem; w[m]←wd; p[m]←pn; f[m]←fl;
end;
procedure init # enters grimm data;
begin m←0;
box(34) # (indent) In; glue(6,3,2);
box(42) # olden; glue(6,3,2);
box(42) # times; glue(6,3,2);
box(41) # when; glue(6,3,2);
box(35) # wish; penalty(6,50,1); "10"
box(24) # ing; glue(6,3,2);
box(29) # still; glue(6,3,2);
box(51) # helped; glue(6,3,2);
box(32) # one,; glue(6,3.75,1.6);
box(40) # there; glue(6,3,2); "20"
box(37) # lived; glue(6,3,2);
box(9) # a; glue(6,3,2);
box(34) # king; glue(6,3,2);
box(47) # whose; glue(6,3,2);
box(48) # daugh; penalty(6,50,1); "30"
box(29) # ters; glue(6,3,2);
box(35.5) # were; glue(6,3,2);
box(19) # all; glue(6,3,2);
box(37) # beau; penalty(6,50,1);
box(12) # ti; penalty(6,50,1); "40"
box(26) # ful;; glue(6,4.5,4/3);
box(29) # and; glue(6,3,2);
box(25) # the; glue(6,3,2);
box(47) # young; penalty(6,50,1);
box(22) # est; glue(6,3,2); "50"
box(28.5) # was; glue(6,3,2);
box(16) # so; glue(6,3,2);
box(37) # beau; penalty(6,50,1);
box(12) # ti; penalty(6,50,1);
box(21) # ful; glue(6,3,2); "60"
box(33) # that; glue(6,3,2);
box(25) # the; glue(6,3,2);
box(27) # sun; glue(6,3,2);
box(12) # it; penalty(6,50,1);
box(31) # self,; glue(6,3.75,1.6); "70"
box(46) # which; glue(6,3,2);
box(26) # has; glue(6,3,2);
box(33) # seen; glue(6,3,2);
box(16) # so; glue(6,3,2);
box(47.5) # much,; glue(6,3.75,1.6); "80"
box(28.5) # was; glue(6,3,2);
box(42) # aston; penalty(6,50,1);
box(40) # ished; glue(6,3,2);
box(41) # when; penalty(6,50,1);
box(32) # ever; glue(6,3,2); "90"
box(12) # it; glue(6,3,2);
box(44) # shone; glue(6,3,2);
box(15) # in; glue(6,3,2);
box(25) # her; glue(6,3,2);
box(36) # face.; glue(8,9,2/3); "100"
box(42) # Close; glue(6,3,2);
box(19.5) # by; glue(6,3,2);
box(25) # the; glue(6,3,2);
box(46) # king's; glue(6,3,2);
box(44) # castle; glue(6,3,2); "110"
box(23) # lay; glue(6,3,2);
box(9) # a; glue(6,3,2);
box(40) # great; glue(6,3,2);
box(36) # dark; glue(6,3,2);
box(22) # for; penalty(6,50,1); "120"
box(27) # est,; glue(6,3.75,1.6);
box(29) # and; glue(6,3,2);
box(20) # un; penalty(6,50,1);
box(25) # der; glue(6,3,2);
box(19) # an; glue(6,3,2); "130"
box(24) # old; glue(6,3,2);
box(39) # lime-; penalty(0,75,1);
box(30) # tree; glue(6,3,2);
box(15) # in; glue(6,3,2);
box(25) # the; glue(6,3,2); "140"
box(22) # for; penalty(6,50,1);
box(22) # est; glue(6,3,2);
box(28.5) # was; glue(6,3,2);
box(9) # a; glue(6,3,2);
box(35.5) # well,; glue(6,3.75,1.6); "150"
box(29) # and; glue(6,3,2);
box(41) # when; glue(6,3,2);
box(25) # the; glue(6,3,2);
box(28) # day; glue(6,3,2);
box(28.5) # was; glue(6,3,2); "160"
box(33.5) # very; glue(6,3,2);
box(48.5) # warm,; glue(6,3.75,1.6);
box(25) # the; glue(6,3,2);
box(46) # king's; glue(6,3,2);
box(38) # child; glue(6,3,2); "170"
box(37) # went; glue(6,3,2);
box(26) # out; glue(6,3,2);
box(30.5) # into; glue(6,3,2);
box(25) # the; glue(6,3,2);
box(22) # for; penalty(6,50,1); "180"
box(22) # est; glue(6,3,2);
box(29) # and; glue(6,3,2);
box(23) # sat; glue(6,3,2);
box(41.5) # down; glue(6,3,2);
box(19.5) # by; glue(6,3,2); "190"
box(25) # the; glue(6,3,2);
box(30) # side; glue(6,3,2);
box(15) # of; glue(6,3,2);
box(25) # the; glue(6,3,2);
box(31.5) # cool; glue(6,3,2); "200"
box(35) # foun; penalty(6,50,1);
box(36) # tain;; glue(6,4.5,4/3);
box(29) # and; glue(6,3,2);
box(41) # when; glue(6,3,2);
box(25) # she; glue(6,3,2); "210"
box(28.5) # was; glue(6,3,2);
box(44) # bored; glue(6,3,2);
box(25) # she; glue(6,3,2);
box(35.5) # took; glue(6,3,2);
box(9) # a; glue(6,3,2); "220"
box(51) # golden; glue(6,3,2);
box(34) # ball,; glue(6,3.75,1.6);
box(29) # and; glue(6,3,2);
box(45) # threw; glue(6,3,2);
box(12) # it; glue(6,3,2); "230"
box(20) # up; glue(6,3,2);
box(19) # on; glue(6,3,2);
box(34) # high; glue(6,3,2);
box(29) # and; glue(6,3,2);
box(52.5) # caught; glue(6,3,2); "240"
box(17) # it;; glue(6,4.5,4/3);
box(29) # and; glue(6,3,2);
box(29) # this; glue(6,3,2);
box(29) # ball; glue(6,3,2);
box(28.5) # was; glue(6,3,2); "250"
box(25) # her; glue(6,3,2);
box(40) # favor; penalty(6,50,1);
box(20) # ite; glue(6,3,2);
box(33) # play; penalty(6,50,1);
box(46) # thing.; penalty(0,1000,0); glue(0,180000,0);
end;
procedure massage # computes the accumulated sums for breaks;
begin integer i,j; real width, stretch, shrink;
width←stretch←shrink←0;
for i←1 step 1 until m do case t[i] of begin
[boxitem] begin b[i]←0; width←width+w[i] end;
[glueitem] begin if i>1 and t[i-1]=boxitem then
begin b[i]←1; w1[i]←w2[i]←width;
y1[i]←y2[i]←stretch; z1[i]←z2[i]←shrink;
j←i;
while j≤m and t[j]≠boxitem do
begin if t[j]=glueitem then
begin w2[i]←w2[i]+w[j];
y2[i]←y2[i]+y[j]; z2[i]←z2[i]+z[j];
end;
j←j+1;
end;
end
else b[i]←0;
width←width+w[i]; stretch←stretch+y[i]; shrink←shrink+z[i] end;
[penaltyitem] begin if p[i]<1000 then
begin b[i]←1; w2[i]←width; w1[i]←width+w[i];
y1[i]←y2[i]←stretch; z1[i]←z2[i]←shrink;
j←i+1;
while j≤m and t[j]≠boxitem do
begin if t[j]=glueitem then
begin w2[i]←w2[i]+w[j];
y2[i]←y2[i]+y[j]; z2[i]←z2[i]+z[j];
end;
j←j+1;
end;
end
else b[i]←0;
end;
else comment do nothing;
end;
b[m+1]←1; w1[m+1]←width; y1[m+1]←stretch; z1[m+1]←shrink;
b[0]←1; t[0]←boxitem; w2[0]←y2[0]←z2[0]←0;
end;
real procedure ratio(integer j,k) # computes the adjustment ratio;
begin real excess; excess←l-(w1[k]-w2[j]);
if excess=0 then return(0)
else if excess>0 then
if y1[k]-y2[j]≤0 then return(1000) else return(excess/(y1[k]-y2[j]))
else if z1[k]-z2[j]≤0 then return(-1000) else return(excess/(z1[k]-z2[j]));
end;
real procedure dem(integer j,k) # computes demerits;
begin real tmp; tmp←abs(ratio(j,k));
if t[k]≠penaltyitem then return((1+100*tmp↑3)↑2)
else if p[k]≥0 then return((1+100*tmp↑3+p[k])↑2)
else return((1+100*tmp↑3)↑2-p[k]↑2);
end;
procedure pack!em!in # tightest fit preferring non-hyphenation;
begin real r; integer i,j,k;
maxr←-1000000; minr←1000000; hyphs←0;
j←i←0;
while true do
begin i←i+1;
if b[i] and (i>m or w1[i]-w2[j]-z1[i]+z2[j]>l) then
begin if w1[i]-w2[j]-z1[i]+z2[j]>l then
begin k←i-1;
while b[k]=0 or (t[k]=penaltyitem and f[k]) do k←k-1;
if w1[k]-w2[j]+y1[k]-y2[j]<l then
begin k←i-1;
while b[k]=0 do k←k-1;
if t[k]=penaltyitem and f[k] then hyphs←hyphs+1;
end;
i←k;
end;
r←ratio(j,i);
if tracing then print("[",i,"=>",r,"]");
if r>maxr then maxr←r;
if r<minr then minr←r;
if i>m then done;
j←i;
end;
end;
print(" ",minr,":",maxr," ",hyphs,"|");
end;
procedure barnett # first-fit preferring non-hyphenation;
begin real r; integer i,j,k;
maxr←-1000000; minr←1000000; hyphs←0;
j←i←0;
while true do
begin i←i+1;
if b[i] and (i>m or (t[i]≠penaltyitem and w1[i]-w2[j]>l)) then
begin if w1[i]-w2[j]-z1[i]+z2[j]>l then
begin k←i-1;
while b[k]=0 or (t[k]=penaltyitem and f[k]) do k←k-1;
if w1[k]-w2[j]+y1[k]-y2[j]<l then
begin k←i-1;
while b[k]=0 or w1[k]-w2[j]-z1[k]+z2[j]>l do k←k-1;
if t[k]=penaltyitem and f[k] then hyphs←hyphs+1;
end;
i←k;
end;
r←ratio(j,i);
if tracing then print("[",i,"=>",r,"]");
if r>maxr then maxr←r;
if r<minr then minr←r;
if i>m then done;
j←i;
end;
end;
print(" ",minr,":",maxr," ",hyphs,"|");
end;
procedure best!fit # line-at-a-time best fit;
begin real r,bestb,bestr; integer i,j,k,besti;
maxr←-1000000; minr←1000000; hyphs←0;
i←j←0; bestb←1000000; besti←j;
while true do
begin i←i+1;
if b[i] then
begin if i>m or (w1[i]-w2[j]-z1[i]+z2[j]>l) then
begin if w1[i]-w2[j]-z1[i]+z2[j]>l then i←besti;
if i≤m and bestb≥999999 then
begin print(" (failure)*"); return;
end;
r←ratio(j,i);
if tracing then print("[",i,"=>",r,"]");
if r>maxr then maxr←r;
if r<minr then minr←r;
if t[i]=penaltyitem and f[i] then hyphs←hyphs+1;
if i>m then done;
j←i; bestb←1000000; besti←j;
end
else
begin real badness;
r←ratio(j,i);
if r≥-1 then badness←100*abs(r)↑3 else badness←10000000;
if t[i]=penaltyitem then badness←badness+p[i];
if badness≤bestb then
begin bestb←badness;
besti←i; bestr←r;
end;
end;
end;
end;
print(" ",minr,":",maxr," ",hyphs,"*");
end;
procedure tracecount;
begin integer i;
for i←0 step 1 until m+1 do if c[i] then
print("[",i,"->",c[i],"]");
end;
integer procedure count!em # exhaustive count, not optimized;
begin real r; integer i,j,k;
c[0]←1;
for i←1 step 1 until m+1 do if b[i] then
begin integer sum; sum←0;
for j←0 step 1 until i-1 do if b[j] then
begin if w1[i]-w2[j]+y1[i]-y2[j]≥l and
w1[i]-w2[j]-z1[i]+z2[j]≤l then sum←sum+c[j];
end;
c[i]←sum;
end
else c[i]←0;
if tracing then tracecount;
return(c[m+1]);
end;
integer procedure count!em!sans!hyphens;
begin real r; integer i,j,k;
c[0]←1;
for i←1 step 1 until m+1 do if b[i] and
(t[i]≠penaltyitem or f[i]=0) then
begin integer sum; sum←0;
for j←0 step 1 until i-1 do if b[j] and
(t[j]≠penaltyitem or f[j]=0) then
begin if w1[i]-w2[j]+y1[i]-y2[j]≥l and
w1[i]-w2[j]-z1[i]+z2[j]≤l then sum←sum+c[j];
end;
c[i]←sum;
end
else c[i]←0;
if tracing then tracecount;
return(c[m+1]);
end;
procedure range(integer n1,n2);
begin integer n;
for n←n1 step 1 until n2 do
begin real maxr1,minr1; integer hyph1;
print('15&'12,n); l←n;
barnett;
maxr1←maxr; minr1←minr; hyph1←hyphs;
best!fit;
if maxr=maxr1 then s1←s1+1 else if maxr<maxr1 then s2←s2+1 else s3←s3+1;
if minr=minr1 then s4←s4+1 else if minr<minr1 then s5←s5+1 else s6←s6+1;
if hyphs=hyph1 then s7←s7+1 else if hyphs<hyph1 then s8←s8+1 else s9←s9+1;
print(" ",count!em,",",count!em!sans!hyphens,".");
end;
print('15&'12,"Statistics so far: max ",s1,"=",s2,">",s3,"<;",
" min ",s4,"=",s5,">",s6,"<;",
" hyph ",s7,"=",s8,">",s9,"<. ");
end;
comment the program starts here;
setprint("tale.tmp","b");
init; massage; tracing←0;
s1←s2←s3←s4←s5←s6←s7←s8←s9←0;
bail;
end